home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 11 / FM Towns Free Software Collection 11.iso / t_os / tool / itl / sel / bgsel.bas < prev    next >
Encoding:
BASIC Source File  |  1995-08-19  |  4.7 KB  |  138 lines
  1. 10000 '
  2. 10010 '     『尽せり』　サンプル
  3. 10020 '　　　Ｔ－ＭＥＮＵ　　壁紙張り替えツール
  4. 10030 '                                   Programed by きょうてん
  5. 10040 '   ＜＜＜  [SEL16.BAS]をマージしてセーブし直してください　＞＞＞
  6. 10050 S_右下Ｘ=319:S_右下Ｙ=239
  7. 10060 DIM WORK%(320*120-1),I%(255)
  8. 10070 MAXX=640-1:MAXY=480-1
  9. 10080 ON ERROR GOTO *ERROR
  10. 10090 BG$="\TMENU.TIF":S_FILE$="BGSEL.CNF"
  11. 10100 OPEN "I",#1,S_FILE$
  12. 10110 A$="":WHILE A$=""
  13. 10120  LINE INPUT#1,A$:IF LEFT$(A$,2)="//" OR A$="" THEN A$=""
  14. 10130 WEND:BG$=A$
  15. 10140 *MAIN
  16. 10150 SCREEN@ 1:CLS:S_FILE$=""
  17. 10160 SYMBOL(10,80),"BGSELECTOR",3,5,7,,,7,2
  18. 10170 *ENTRY ER=0
  19. 10180 '＝－＝－＝－＝－＝－＝＝　呼び出し基本形　－＝－＝－＝－＝－＝－＝
  20. 10190 S_INPUT=0:S_PATH=0:S_KAKU$=".TIF":S_MES$="BGSELECT"
  21. 10200 GOSUB *S_SEL:IF S_FILE$="" THEN END
  22. 10210 '＝－＝－＝－＝－＝－＝－＝－＝－＝－＝－＝－＝－＝－＝－＝－＝－＝
  23. 10220 A=INSTR(S_FILE$,".")
  24. 10230 IF A>0 THEN A$=MID$(S_FILE$,A,4) ELSE A$=""
  25. 10240 IF A$<>".TIF" THEN
  26. 10250  M$=".TIFファイルを指定してね":GOSUB *YN:GOTO *ENTRY
  27. 10260 ENDIF
  28. 10270 GOSUB *LOADTIF
  29. 10280 IF ER THEN GOSUB *YN:GOTO *MAIN
  30. 10290 IF JJ=1 OR JJ=4 THEN SCREEN@ 0
  31. 10300 IF JJ=8 THEN SCREEN@ 2
  32. 10310 IF JJ=16 THEN SCREEN@ 1
  33. 10320 MOUSE 1,,,0:LOAD@ S_FILE$,(0,0):MOUSE 1,,,1
  34. 10330 IF JJ=8 THEN GOSUB *TIF256
  35. 10340 *SAVE
  36. 10350 A=MOUSE(3,1):M$="この絵でいい－左　選び直す－右":GOSUB *YN
  37. 10360 IF MOUSE(3,1) THEN *ENTRY
  38. 10370 IF MOUSE(0)=0 AND MOUSE(1)=0 AND JJ<>1 AND JJ<>4 THEN
  39. 10380  WHILE MOUSE(2,0):WEND:GOSUB *WHIPSCUT:END
  40. 10390 ENDIF
  41. 10400 IF JJ<>16 THEN SAVE@ BG$,(0,0)-(OX,OY),1 ELSE SAVE@ BG$,(0,0)-(OX,OY)
  42. 10410 END
  43. 10420 '========================  ＴＩＦＦを読む
  44. 10430 *LOADTIF
  45. 10440 START&=VARPTR(WORK%(0)):FILE$=S_FILE$+CHR$(0)
  46. 10450 RET&=CALLM(0,12,20,START&,VARPTR(FILE$),0,4096)
  47. 10460 P&=0
  48. 10470 'ヘッダ
  49. 10480 IF PEEK([20]START&,4)<>&H002A4949 THEN M$="標準TIFFじゃないっす":ER=-1:RETURN
  50. 10490 P&=START&+PEEK([20]START&+4,4)
  51. 10500 'ＩＦＤ
  52. 10510 JJ=4:II=PEEK([20]P&,2):P&=P&+2
  53. 10520 FOR I=0 TO II-1
  54. 10530  A=PEEK([20]P&,2):A&=PEEK([20]P&+8,2)
  55. 10540  IF A=&H102 THEN
  56. 10550   IF PEEK([20]P&+4,4)=3 THEN M$="フルカラーＴＩＦＦは読めんす":ER=-1:RETURN
  57. 10560    JJ=A&
  58. 10570  ENDIF
  59. 10580  IF A=&H100 THEN OX=A&-1
  60. 10590  IF A=&H101 THEN OY=A&-1
  61. 10600  P&=P&+12
  62. 10610 NEXT
  63. 10620 RETURN
  64. 10630 '======================  ３２７６８色化
  65. 10640 *TIF256
  66. 10650 MOUSE 1,,,0
  67. 10660 IF OX>MAXX THEN OX=MAXX
  68. 10670 IF OY>MAXY THEN OY=MAXY
  69. 10680 IF OX>319 OR OY>239 THEN
  70. 10690  FOR Y=0 TO OY STEP 2
  71. 10700   GET@A(0,Y)-(OX,Y),WORK%:PUT@A(0,Y\2)-(OX,Y\2),WORK%,,.5!
  72. 10710  NEXT:OX=OX\2:OY=OY\2
  73. 10720 ENDIF
  74. 10730 GET@A(0,0)-(OX,OY),WORK%
  75. 10740 FOR I=0 TO 255
  76. 10750  OUT &HFD90,I
  77. 10760  I%(I)=INP(&HFD92)\8+(INP(&HFD94)\8)*32+(INP(&HFD96)\8)*1024
  78. 10770 NEXT
  79. 10780 SCREEN@ 1:PIC&=VARPTR(WORK%(0))
  80. 10790 FOR Y=0 TO OY:P%=0
  81. 10800  FOR X=0 TO OX
  82. 10810   A%=PEEK([20]PIC&):S_SEL%(P%)=I%(A%):P%=P%+1:PIC&=PIC&+1
  83. 10820  NEXT:PUT@A(0,Y)-(OX,Y),S_SEL%
  84. 10830 NEXT
  85. 10840 JJ=16:MOUSE 1,,,1:RETURN
  86. 10850 '==================ＷＨＩＰＳサイズ切り出し
  87. 10860 *WHIPSCUT
  88. 10870 SX=0:SY=0:OX=229:OY=229
  89. 10880 MOUSE 4,0,0,319,239
  90. 10890 GOSUB *WAKU:X=-1
  91. 10900 WHILE MOUSE(2,1)+MOUSE(2,0)=0
  92. 10910  XX=X:YY=Y:X=MOUSE(0):Y=MOUSE(1)
  93. 10920  IF X<>XX OR Y<>YY OR MOUSE(2,0)=-1 THEN
  94. 10930   GOSUB *WAKU
  95. 10940   SX=X-OX:IF SX<0 THEN SX=0
  96. 10950   SY=Y-OY:IF SY<0 THEN SY=0
  97. 10960   GOSUB *WAKU
  98. 10970  ENDIF
  99. 10980 WEND
  100. 10990 IF MOUSE(2,1) THEN WHILE MOUSE(2,1):WEND:GOSUB *WAKU:RETURN *SAVE
  101. 11000 LINE(SX,SY)-(SX+OX,SY+OY),PSET,7,B
  102. 11010 S_INPUT=-1:S_MES$="WHIPS":GOSUB *S_SEL
  103. 11020 IF S_FILE$<>"" THEN BG$=S_FILE$:SAVE@ BG$,(SX,SY)-(SX+OX,SY+OY):RETURN
  104. 11030 RETURN *ENTRY
  105. 11040 *WAKU LINE(SX,SY)-(SX+OX,SY+OY),XOR,2,B,&HEEEE:RETURN
  106. 11050 *YN
  107. 11060 GET@A(0,0)-(511,15),WORK%
  108. 11070 LINE(0,0)-(511,15),PSET,1,BF
  109. 11080 SYMBOL(0,0),M$,1,1,7:MOUSE 1,,,1
  110. 11090 WHILE MOUSE(2,0)+MOUSE(2,1)<>0:WEND
  111. 11100 WHILE MOUSE(2,0)+MOUSE(2,1)=0:WEND
  112. 11110 PUT@A(0,0)-(511,15),WORK%
  113. 11120 RETURN
  114. 11130 *ERROR
  115. 11140 IF ERR=55 THEN
  116. 11150  M$="ファイル名が変だ！"
  117. 11160 ELSE IF ERR=73 THEN
  118. 11170  M$="ライトプロテクトかかってます"
  119. 11180 ELSE IF ERR=75 THEN
  120. 11190  M$="アクセスが拒否されちゃった"
  121. 11200 ELSE IF ERR=72 THEN
  122. 11210  M$="ディスクが使用可能になってないよ"
  123. 11220 ELSE IF ERR=67 THEN
  124. 11230  M$="このディスクすでにいっぱいかも"
  125. 11240 ELSE IF ERR=65 THEN
  126. 11250  M$="ディレクトリが一杯になったぞ"
  127. 11260 ELSE IF ERR=63 THEN
  128. 11270  IF S_FILE$="BGSEL.CNF" THEN RESUME *MAIN
  129. 11280  M$="ファイルが見つかりません":GOSUB *YN:RESUME *MAIN
  130. 11290 ELSE IF ERR=64 THEN
  131. 11300  KILL BG$:RESUME
  132. 11310 ELSE
  133. 11320  M$="おおっと"+STR$(ERL)+",ERROR"+STR$(ERR)
  134. 11330  GOSUB *YN
  135. 11340  RESUME *ENTRY
  136. 11350 ENDIF
  137. 11360 GOSUB *YN:RESUME NEXT
  138.